home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / clipper / nfsrc21.zip / POPADDER.PRG < prev    next >
Text File  |  1991-08-17  |  45KB  |  1,292 lines
  1. /*
  2.  * File......: Popadder.prg
  3.  * Author....: Keith A. Wire
  4.  * CIS ID....: 73760,2427
  5.  * Date......: $Date:   17 Aug 1991 15:44:30  $
  6.  * Revision..: $Revision:   1.2  $
  7.  * Log file..: $Logfile:   E:/nanfor/src/popadder.prv  $
  8.  * 
  9.  * This is an original work by Keith A. Wire and is placed in the
  10.  * public domain.
  11.  *
  12.  * Modification history:
  13.  * ---------------------
  14.  *
  15.  * $Log:   E:/nanfor/src/popadder.prv  $
  16.  * 
  17.  *    Rev 1.2   17 Aug 1991 15:44:30   GLENN
  18.  * Don Caton fixed some spelling errors in the doc
  19.  * 
  20.  *    Rev 1.1   15 Aug 1991 23:04:12   GLENN
  21.  * Forest Belt proofread/edited/cleaned up doc
  22.  * 
  23.  *    Rev 1.0   14 Jun 1991 17:37:54   GLENN
  24.  * Initial revision.
  25.  *
  26.  */
  27.  
  28.  
  29. /*
  30.  * File......: Popadder.prg
  31.  * Author....: Keith A. Wire
  32.  * CIS ID....: 73760,2427
  33.  * Date......: $Date:   17 Aug 1991 15:44:30  $
  34.  * Revision..: $Revision:   1.2  $
  35.  * Log file..: $Logfile:   E:/nanfor/src/popadder.prv  $
  36.  * 
  37.  * This is an original work by Keith A. Wire and is placed in the
  38.  * public domain.
  39.  *
  40.  * Modification history:
  41.  * ---------------------
  42.  *
  43.  * $Log$
  44.  * 
  45.  *    Rev 1.0   14 Jun 1991 17:37:54   GLENN
  46.  * Initial revision.
  47.  *
  48.  */
  49.  
  50.  
  51. /*  $DOC$
  52.  *  $FUNCNAME$
  53.  *      FT_Adder()
  54.  *  $CATEGORY$
  55.  *      Menus/Prompts
  56.  *  $ONELINER$
  57.  *      Pop up a simple calculator
  58.  *  $SYNTAX$
  59.  *      FT_Adder()
  60.  *  $ARGUMENTS$
  61.  *      None
  62.  *  $RETURNS$
  63.  *      NIL .... but optionally places Total of calculation in active 
  64.  *               Get variable using oGet:VARPUT()
  65.  *  $DESCRIPTION$
  66.  *      PopAdder() gives you an adding machine inside your Clipper 5.01
  67.  *      application. It has the basic functions add, subtract, multiply,
  68.  *      and divide. You may move it from one side of the screen to the
  69.  *      other. It even displays a scrollable tape, if you want it.
  70.  *
  71.  *
  72.  *      The Help screen below gives a brief description of the operation
  73.  *      of the adder.              
  74.  *          
  75.  *
  76.  *                  ┌─────── INSTRUCTIONS ───────┐
  77.  *                  │                            │
  78.  *                  │ All number keys as usual   │
  79.  *                  │ <+> <-> keys as usual      │
  80.  *                  │ <SPACE>─┬─shift <+> to <*> │
  81.  *                  │         └─shift <-> to </> │
  82.  *                  │  <D>    change decimal pt. │
  83.  *                  │  <M>    move ADDER         │
  84.  *                  │  <T>    display tape       │
  85.  *                  │  <S>    scroll tape disp.  │
  86.  *                  │ <DEL>───┬─1st Clear entry  │
  87.  *                  │         └─2nd Clear ADDER  │
  88.  *                  │ <ESC>   to Quit            │
  89.  *                  │ <F10>   to Return Total    │
  90.  *                  │           to program       │
  91.  *                  │                            │
  92.  *                  └──── Any Key to Continue ───┘
  93.  *
  94.  *
  95.  *
  96.  *      A couple of notes about the adder:
  97.  *
  98.  *
  99.  *      1.) It was designed to be used on an Enhanced keyboard with
  100.  *          separate <DELETE> key. <DELETE> is used to clear the adder.
  101.  *          However, it will still work on a Standard keyboard.
  102.  *
  103.  *      2.) It uses the <SPACE> bar to shift from Add/Subtract
  104.  *          mode to Multiply/Divide. That means the <+> and <-> keys
  105.  *          become the <*> and </> keys.   
  106.  *
  107.  *      3.) You do not have to display the tape. You may turn it on
  108.  *          at any time by pressing <T>. You may SCROLL back through
  109.  *          the tape once there are more than 16 entries in the 
  110.  *          adder, by pressing <S>.
  111.  *
  112.  *      4.) To Quit the Adder just press <ESC>. To return your Total
  113.  *          to the application press <F10>. The adder will place the
  114.  *          Total in the active GET variable using oGet:VarPut(). The
  115.  *          adder will only return a Total to a numerical GET!
  116.  *
  117.  *      5.) There are many support functions that you might find
  118.  *          interesting. They are part of my personal library, but 
  119.  *          are necessary to the operation of the adder.
  120.  *          You might want to pull these out to reduce the overall
  121.  *          size of the adder. Many are worth at least a little
  122.  *          time studying.
  123.  *
  124.  *      6.) To make FT_Adder a Hot key from inside your application
  125.  *          at the beginning of your application add the line:
  126.  *
  127.  *                 SET KEY K_ALT_A  TO FT_Adder
  128.  *
  129.  *          This will make <ALT-A> a key "Hot" and permit you to 
  130.  *          Pop - Up the adder from anywhere in the application.
  131.  *
  132.  *      7.) If you use FT_SINKEY(), you can even have active hotkeys
  133.  *          in an INKEY().
  134.  *
  135.  *
  136.  *
  137.  *
  138.  *  $EXAMPLES$
  139.  *  
  140.  *  $SEEALSO$
  141.  *
  142.  *  $INCLUDE$
  143.  *     INKEY.CH, SET.CH, SETCURS.CH, ACHOICE.CH
  144.  *  $END$
  145.  */
  146.  
  147. #include 'Inkey.ch'
  148. #include 'Set.ch'
  149. #include 'SetCurs.ch'
  150. #include 'achoice.ch'
  151.  
  152. #define K_PLUS  43
  153. #define K_MINUS 45
  154. #define K_SPACE 32
  155. #define nTotTran LEN(aTrans)
  156. #define MUST_READ .T.
  157. #define POP_ON    .T.
  158. #define POP_OFF   .F.
  159. #define B_DOUBLE '╔═╗║╝═╚║ '
  160. #define B_SINGLE '┌─┐│┘─└│ '
  161.  
  162. // Set up manifest constants to access the window colors in the array aWinColor
  163. #define W_BORDER 1
  164. #define W_ACCENT 2
  165. #define W_PROMPT 3
  166. #define W_SCREEN 4
  167. #define W_TITLE  5
  168. #define W_VARIAB 6
  169. #define W_CURR   NIL
  170.  
  171. // Set up manifest constants to access the Standard screen colors in the array
  172. // aStdColor
  173. #define STD_ACCENT   1
  174. #define STD_ERROR    2
  175. #define STD_PROMPT   3
  176. #define STD_SCREEN   4
  177. #define STD_TITLE    5
  178. #define STD_VARIABLE 6
  179. #define STD_BORDER   7
  180.  
  181.  
  182. /* This ASHRINK is by Rick Spence */
  183. #define ASHRINK(ar) ASIZE(ar,LEN(ar)-1)
  184.  
  185. #command DISPMESSAGE <mess>,<t>,<l>,<b>,<r> => ;
  186.          _ftPushKeys(); KEYBOARD CHR(K_CTRL_PGDN)+CHR(K_CTRL_W);;
  187.          MEMOEDIT(<mess>,<t>,<l>,<b>,<r>); _ftPopKeys()
  188.  
  189. /* This INKEY UDC was posted by Don Caton on NanForum... Thanks Don <g> */
  190. #command INKEY [ <secs> ] TO <var>                                       ;
  191.          =>                                                            ;
  192.          WHILE (.T.)                                                  ;;
  193.             <var> := Inkey([ <secs> ])                                  ;;
  194.             IF Setkey(<var>) # NIL                                    ;;
  195.                Eval( Setkey(<var>), ProcName(), ProcLine(), #<var> )  ;;
  196.             ELSE                                                      ;;
  197.                EXIT                                                   ;;
  198.             END                                                       ;;
  199.          END
  200.  
  201. MEMVAR getlist
  202.  
  203. STATIC nTotal,nNumTotal,nSavTotal,cDefTotPict,cTotPict,lShowRight
  204. STATIC nAddSpace,nTapeSpace,nTopTape,lClAdder,lDecSet,nDecDigit,nMaxDeci
  205. STATIC lMultDiv,nAddMode,lSubRtn,cTapeScr,lTotalOk,lAddError
  206. STATIC aTrans,lTape, nTopOS, nLeftOS, lNewNum, nSavSubTotal, lDivideErr
  207.  
  208. STATIC aHelpStack := {}, aKeys := {}
  209. STATIC lStatMustRing := .T.             // Change this to .F. if you don't
  210.                                         // want the bell on inputs
  211.  
  212. STATIC aWindow   := {}, nWinColor := 0  
  213. STATIC aWinColor, aStdColor
  214.  
  215. #ifdef FT_TEST
  216.  
  217.   FUNCTION TEST
  218.  
  219.     LOCAL nSickHrs := 0, ;
  220.           nPersHrs := 0, ;
  221.           nVacaHrs := 0
  222.  
  223.     aWinColor := { {'GR+/BG','GR+/G', 'B+/RB', 'G+/R'} , ;
  224.                    {'R+/N',   'W+/RB','W+/BG','GR+/B'} , ;
  225.                    {'GR+/N', 'GR+/N','GR+/N', 'GR+/N'} , ;
  226.                    {  'B/BG','BG+/G', 'W+/RB','BG+/R'} , ;
  227.                    { 'W+/BG', 'W+/G','GR+/RB', 'W+/R'} , ;
  228.                    {'GR+/B', 'GR+/R', 'R+/B',  'W+/BG'},; 
  229.                    {  'N/N',   'N/N',  'N/N',   'N/N'}   }
  230.  
  231.     aStdColor := { 'BG+*/RB' , ;                          
  232.                     'GR+/R'  , ;                          
  233.                     'GR+/N'  , ;                          
  234.                       'W/B'  , ;                          
  235.                     'GR+/N'  , ;                          
  236.                     'GR+/GR' , ;                          
  237.                    { 'W+/B',  'W/B','G+/B','R+/B',;       
  238.                     'GR+/B','BG+/B','B+/B','G+/B'},;
  239.                       'N/N'    }
  240.  
  241.